home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
WAFPEGTP
/
WAFPEG.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-08-20
|
33KB
|
1,027 lines
{$A+,B-,D-,E-,F-,I-,L-,N-,O-,R+,S+,V-}
{$M 65000,0,10000}
program wafpeg;
{
Take incoming mail from waffle 1.65 user mailboxes and splatter into
individual PMail compatible .cnm mail items. Part of wafpeg udg.
Copyright (C) 1992 Dr Ross Lazarus
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 1, or (at your option)
any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
Dr Ross Lazarus is the original copyright holder of this code.
Email: rossl@gmu.wh.su.edu.au
Mail: Department of Community Medicine,
Westmead Hospital
Westmead, NSW 2145
Australia
Fax: (+61 2) 689 1049
+ hacked 20/august 1994 rml to get rid of pmuser in stand alone mode.
+ modified for public release of code excluding the unit needed for remote
server mapping. Single MUST be defined. rml 16 january 1994
+ modified rfc822 date to include tz rml 4/april 1993
+ additional parameter for standalone added - a which forces all mail into
the pmuser environment variable mailbox if present in standalone mode
rml 6/march 1993
+ standalone mode added 17/2/93 rml
+ major rewrite of mailbox splatter code to use index file
necessitated by the complexities of what might be in there
a major bunch of bugs and code changed ! 20/8/92 rml
+ major reshuffle of delivery code to permit MULTIPLE forward addresses
in forward.p - each line not starting with # assumed to be server/user
if server is blank, assumed to be on gateway 20/8/92 rml
+ made log file a little more like uucico's 13/8/92
+ added rfc822 dates in received by lines 10/8/92
+ added parameter types - eg /Nf:\mail for f:\mail as network
mail drive, /d - nokill/debug /? - help /p = remote password
/u = remote user rml 9/8/92
+ added detach code from remote server rml 8/8/92
revision 6 adds the option of forwarding to remote servers - if the
users waffle directory contains a forward file called forward.p.
with an entry of the form
fileservername/user
stuff is delivered to that user's novell mailbox.
Possible to fake forwarding to the same server, but the userid logged in
while this programming is running needs cws access to sys:mail
The userid and password to be used on the remote server must be passed
to this program for that to work. Default is guest with no password
revision 5 takes all spaces out of static file lines before looking
for spool: in the waffle static file - upper case used to avoid
problems.
revision 4 reads waffle environmental variable and gets waffle
user directory directly from the static file
reads waffle 1.65 mailboxes from the subdirectories of a waffle user
directory (from the Waffle static file) and parses and writes the contents
to the users mail directory in Pegasus mail compatible files in a network
mail directory (user supplied parameter). The waffle user subdirectory name
is the waffle user name. Looks in the netware bindery for a user of the SAME
name and uses the netware hexid as the network users mail subdirectory.
Assumes that each subdir of the supplied waffle user directory
has a name which is also the network name for that user
rml
june 1992
known bugs : contact rossl@westmead.health.su.OZ.AU with your finds !
}
{$define single}
(*
To compile this public code release, single MUST be defined. Otherwise
you need remote novell server login/map code which will be provided for
an appropriate fee to those wanting it
*)
{$ifdef single}
uses dos,crt,novell,awindow;
{$else}
uses dos,crt,novell,novell2,awindow;
{$endif}
const
copyright = 'Copyright (C) Dr Ross Lazarus, August 1992';
copyright2 = 'All rights reserved. Unauthorised use and distribution prohibited';
standalone : boolean = false;
pmenv = 'PMUSER';
debug : boolean = false;
logdirs : boolean = false;
some : boolean = false;
allmail : boolean = false;
prog = 'WafPeg';
ver = '0.27s, 94.08.20';
waffleset = 'WAFFLE';
userdirtag = 'USER:';
hosttag = 'NODE:';
tztag = 'TIMEZONE:';
forwardfilename = 'FORWARD.P';
wafdir : string = '\waffle\system\static';
progname = 'Waffle 1.65 mailbox --> Pegasus Mail Converter';
version = 'Version ' + ver + ', rossl@gmu.wh.su.edu.au';
killfile : boolean = true; { controls deletion of old mailboxes }
pmailext = '.CNM'; { new mail file extension }
userdir : string = 'c:\waffle\user'; { default }
netmaildir : string = 'f:\mail';
remotedrive = 'M:';
remotemapping = remotedrive + '=sys:';
remuser : string = 'guest';
rempass : string = '';
userobject = 1;
remotenetmaildir : string = remotedrive + '\mail';
mb = 'mailbox.f'; { name of mailbox text file }
omb = 'orphan.f'; { orphaned mail }
mbi = 'mailbox.i';
maxbuf = 16384;
type
hexidtype = array[1..4] of byte;
windex = record { a waffle mailbox index file record }
offset : longint;
length : longint;
stuff : array[1..28] of byte;
end;
var
i,j,defaultserverid,dummy : integer;
s,timezone,hostname,gateservername,homedir : string;
c : char;
function mirt(trime : String) : String;
{ trim all blanks }
const
blank = ' ';
var
l : integer;
t : string;
begin
t := '';
for l := 1 to length(trime) do
if (trime[l] <> blank) then
t := t + trime[l];
mirt := t;
end; { mirt }
function UpcaseStr(S : String) : String;
(* converts a string to upper case *)
var
P : Integer;
begin
for P := 1 to Length(S) do
S[P] := Upcase(S[P]);
UpcaseStr := S;
end; { Upcasestr }
function before(sep : string ; s : string) : string;
{
return characters up to sep in s
if no sep, return whole of s
}
var
i : integer;
begin
i := pos(sep,s);
if (i = 0) then
before := s
else
before := copy(s,1,pred(i));
end;
function after(sep :string ; var s : string) : string;
{
return characters after sep in s
if no sep, returns null string
}
var
i,j,l : integer;
begin
l := length(s);
j := length(sep);
i := pos(sep,s);
while (copy(s,i+j,j) = sep) and (i < l) do
inc(i,j);
if (i = 0) or (i >= l) then
after := ''
else
after := copy(s,i + j,999);
end; { after }
{---------------- date and time support ------------------}
const
daypos = 1;
monthpos = 3;
Limit : Array[1..13] of Integer = (31,29,31,30,31,30,31,31,30,31,30,31,31);
MthTab : Array[1..12] of String[9] = ('Jan','Feb','Mar',
'Apr','May','Jun','Jul',
'Aug','Sep','Oct',
'Nov','Dec');
DayTab : Array[0..6] of String[9] = ('Sun','Mon','Tue',
'Wed','Thu','Fri',
'Sat');
Function SysTime : String;
Var
H, M, S : String[2];
hh,mm,ss,s100 : word;
Begin
gettime(hh,mm,ss,s100);
Str(hh:2, H);
Str(mm:2, M);
Str(ss:2, S);
if H[1] = ' ' then H[1] := '0';
if M[1] = ' ' then M[1] := '0';
if S[1] = ' ' then S[1] := '0';
SysTime := H + ':' + M + ':' + S
End;
Function rfc822date : String;
Var
I : Integer;
S1,S2,today : String[30];
dd,mm,yy,d,hh,ss,s100 : word;
ds : string[2];
ys : string[4];
status,mn : integer;
Begin
getdate(yy,mm,dd,d);
str(dd,ds);
str(yy,ys);
S1 := daytab[D]+', ' + mirt(ds) + ' ' + mthtab[mm] + ' ' + ys;
rfc822Date:= s1 + ' ' + systime + ' ' + timezone;
End;
function findwuserdir : string;
{
find waffle static file from environmental variable
and read to locate user dir
}
var
infile : text;
wuserdir,tmpstring : string;
uppers : string;
ufound,hfound,tzfound : boolean;
c : char;
function find(id,usource,source : string; var dest : string) : boolean;
{
seek id in the source string
if found, return whatever starts with the first alphabetic character
after the id label
}
var
temps : string;
function alphaafter(sep,ups,s : string ) : string;
{
return first alpha characters after sep in s
if no sep, returns null string
uses uppercase version of sep and s to find substring
}
const alpha : set of char = ['0'..'9','A'..'z'];
var
i,j,l : integer;
rets : string;
begin { alphaafter }
sep := upcasestr(sep);
rets := '';
l := length(s);
j := length(sep);
i := pos(sep,ups);
if (i <> 0) then
begin
i := i + j;
while not (ups[i] in alpha) and (i < l) do
inc(i);
if (i > 0) and (i <= l) then
rets := copy(s,i,l);
end; { not there }
alphaafter := rets;
end; { alphaafter }
begin { find }
if (pos(id,usource) <> 0) then
begin
dest := '';
temps := alphaafter(id,usource,source);
if (temps = '') then
begin
writeln(systime,' No ',id,' specified in ',wafdir);
halt(1);
end
else
begin
dest := temps;
find := true;
end;
end { leave dest alone if id not found }
else
find := false;
end; { find }
begin { findwuserdir }
(*
* Waffle uses an environment variable (WAFFLE) to point at the
* static parameters file
*)
hfound := false;
ufound := false;
tzfound := false;
timezone := '(??tz) ';
hostname := '?(NODE: not found in Waffle static file)';
wafdir := getenv(waffleset);
if (wafdir = '') then
begin
writeln(progname,' invoked ',rfc822date);
writeln(version);
writeln(systime, ' ERROR: WAFFLE environment variable has not been defined');
writeln('PLEASE read the Waffle DOS documentation !!!');
writeln(prog,' halting abnormally - dos error code = 1');
halt(1);
end;
{$i-}
assign(infile,wafdir);
reset(infile);
{$i+}
dummy := ioresult;
if (dummy <> 0) then
begin
writeln(progname,' invoked ',rfc822date);
writeln(version);
writeln(systime ,' ERROR: Waffle static file ',wafdir,' cannot be opened');
writeln(prog,' halting abnormally - dos error code = 2');
halt(2);
end;
while not (hfound and ufound) and not eof(infile) do
begin
readln(infile,tmpstring);
if (tmpstring[1] <> ';') and (tmpstring[1] <> '#') and (tmpstring > '') then
begin
tmpstring := mirt(tmpstring);
uppers := upcasestr(tmpstring);
if not ufound then
ufound := find(userdirtag,uppers,tmpstring,wuserdir);
if not hfound then
hfound := find(hosttag,uppers,tmpstring,hostname);
if not tzfound then
tzfound := find(tztag,uppers,tmpstring,timezone);
end;
end; { eof }
close(infile);
if (wuserdir = '') then
begin
writeln(systime ,' ERROR: No USER directory in Waffle Static file ',wafdir);
writeln('Using \waffle\user as default');
wuserdir := '\waffle\user';
end;
findwuserdir := wuserdir;
end; {findwuserdir }
procedure dohelp;
{
provide some assistance
}
begin
writeln('==============',prog,'==============');
writeln(progname);
writeln(version);
writeln('Converts Waffle 1.65 mailboxes into Pegasus mail');
writeln('Parameters available are :-');
writeln(' -n[netware mail directory] => eg -nF:\mail (default)');
writeln(' -d => debug mode - mailbox.f NOT deleted, use ONLY for testing!!');
writeln(' -u[userid for remote server delivery] => eg guest (default)');
writeln(' -p[password for remote server delivery userid] (default is no password)');
writeln(' -l => detailed log of activity');
writeln(' -? or -h => this help text');
writeln('eg ',prog,' -ng:\funnymail -uguest -pguest');
writeln('-n only needs to be set if not the default f:\mail');
writeln('-u and -p only needed for remote mail delivery - please see');
writeln('documentation accompanying this package');
writeln(systime,' ',prog,' terminating');
halt;
end;
procedure paramerror(s : string);
{
explain use
}
begin
writeln(upcasestr(s));
dohelp;
end;
function exists(fn : string) : boolean;
{
return true if fn is a file name
}
var
s : searchrec;
begin
findfirst(fn,anyfile ,s);
exists := (doserror = 0) ;
end;
function hexidtostring(x : hexidtype) : string;
{
translate a 4 byte address into a hex string
}
var
hex_id : string;
id : array[1..4] of byte absolute x;
begin
hex_id := '';
hex_id := hexdigits[Id[1] shr 4]; { lower nibble }
hex_id := hex_id + hexdigits[Id[1] and $0F]; { upper }
hex_id := hex_id + hexdigits[Id[2] shr 4];
hex_id := hex_id + hexdigits[Id[2] and $0F];
hex_id := hex_id + hexdigits[Id[3] shr 4];
hex_id := hex_id + hexdigits[Id[3] and $0F];
hex_id := hex_id + hexdigits[Id[4] shr 4];
hex_id := hex_id + hexdigits[Id[4] and $0F];
hexidtostring := hex_id;
end;
function getmaildir(uname : string) : string;
{
scan bindery for this user and
return hexid plus netmaildir as users mail dir
}
var
uid : string;
retcode : integer;
begin
gethexid(uname,uid,retcode);
if (retcode = 0) and (uid > '') then
getmaildir := uid
else
getmaildir := '';
(*
uid := '';
if standalone then
begin
if not allmail then
uid := uname
else
begin
uid := getenv(pmenv);
if (uid = '') then
begin
writeln(systime,' ',pmenv,' not set.');
writeln('Please read the documentation about setting the ',pmenv );
writeln('DOS environmental variable to the user name where incoming mail');
writeln('is to be left for Pegasus by Wafpeg from Waffle in Standalone mode');
writeln('under the mail directory set on the command line with -n');
writeln('Mail will be delivered to subdirectories of the mail directory');
writeln('which follow the waffle name(s) - the /A parameter is ignored');
uid := uname;
end; { no pmenv }
end; { allmail goes to pmenv name }
getmaildir := uid;
end
else
begin
gethexid(uname,uid,retcode);
if (retcode = 0) and (uid > '') then
getmaildir := uid
else
getmaildir := '';
end; { not standalone }
*)
end; { getmaildir }
procedure scanmaildirs;
{
pass each subdirectory name to the conversion routine
if the name found in the network bindery
}
var
s : searchrec;
procedure copymail(uname : string);
{
copy contents of waffle mailbox in sdir to
netware mail directory destdir with proper pegasus names
}
var
remotegateway : boolean;
remotehandle,remoteserverid : integer;
regs : registers;
frsname,fruname,unmaildir,uwmaildir,unetid,usermailbox,userindex,
userforward,remoteservername,pmailfile : string;
ffile : text;
f : file;
s : string;
delivered : boolean;
function getnewfilename : string;
{
make a random filename which does not yet exist here
}
var
fn : string;
function randstr : string;
{
return a 4 character string of random hex digits
Looks at turbo randseed which is a (4 byte) longint
and converts it to a hex string (8 char) as a file name
}
var
l : longint;
w : word;
h : hexidtype absolute l;
begin { randstr }
w := random(maxint);
l := randseed; { get longint version }
randstr := hexidtostring(h);
end; { randstr }
begin { getnewfilename }
repeat
fn := unmaildir + '\' + randstr + pmailext;
until not exists(fn);
getnewfilename := fn;
end; { getnewfilename }
procedure docopy;
{
read the mailbox file and write out each mail item
notify user if possible
}
const
crlf : string[2] = chr($0d) + chr($0a);
lf = chr($0a);
type
fbuf = array[1..maxbuf] of byte;
var
index : file of windex;
outf,mail : file;
ix : windex;
pmfile : string;
retcode,count,dummy : integer;
toread,mailpos : longint;
bufsize,i,j : word;
s : string;
ifb : fbuf;
c : char;
begin { docopy }
mailpos := 0; { pointer into mailbox file }
count := 0; { number of individual mail items transferred }
{$i-}
assign(index,userindex);
reset(index);
{$i+}
dummy := ioresult;
if (dummy <> 0) then
begin
writeln(systime,' Cannot open ',userindex);
writeln('Is it being used by Waffle or what ???');
exit;
end;
{$i-}
assign(mail,usermailbox);
reset(mail,1);
{$i+}
dummy := ioresult;
if (dummy <> 0) then
begin
writeln(systime,' Cannot open ',usermailbox);
writeln('Is it being used by Waffle ???');
exit;
end;
{$i-}
while not eof(index) do
begin
i := 0;
read(index,ix); { get a set of pointers to the mailfile }
dummy := ioresult;
if (dummy = 0) then
begin { have an index }
pmfile := getnewfilename;
assign(outf,pmfile);
rewrite(outf,1);
dummy := ioresult;
if (dummy <> 0) then
begin
writeln(systime,' Problem opening outfile ',pmfile);
writeln('Need C (3.x) or CW (2.x) rights to sys:mail');
writeln('Mailbox transfer aborted');
exit;
end;
inc(count);
s := 'Received: from ' + gateservername + ' by ' + prog + ' ' + ver + crlf;
if remotegateway then
s := s + ' for ' + frsname + '/' + fruname +
' from ' + gateservername
else
begin
if standalone then
s := s + ' for ' + uname + ' on standalone PMail'
else
s := s + ' for ' + uname + ' on ' + gateservername;
end;
s := s + ' ; ' + rfc822date + crlf;
if (mailpos <= ix.offset) then
begin { normally expect to be 4 short }
blockread(mail,ifb,ix.offset - mailpos);
mailpos := ix.offset;
end
else
begin
writeln(systime,' error - mail file pointer > start of next message !');
writeln(systime,' aborting this mailbox transfer');
delivered := false;
exit;
end;
c := ' ';
i := 0;
while (c <> lf) and not eof(mail) do
begin { find end of 1st line }
blockread(mail,c,1);
blockwrite(outf,c,1);
inc(i);
inc(mailpos);
end;
blockwrite(outf,s[1],length(s)); { add my mark }
toread := ix.length - i;
while (toread > maxbuf) do
begin { do this until near the end }
blockread(mail,ifb,maxbuf);
blockwrite(outf,ifb,maxbuf);
dec(toread,maxbuf);
inc(mailpos,maxbuf);
end; { big file }
blockread(mail,ifb,toread); { last bit }
blockwrite(outf,ifb,toread);
inc(mailpos,toread); { bump file position pointer }
close(outf);
dummy := ioresult;
end; { got an index record }
end; { eof index - no more index entries }
close(index);
dummy := ioresult;
close(mail);
dummy := ioresult;
if remotegateway then
writeln(systime,' ',count,' Waffle mail items ',uwmaildir,
' ==> ',frsname + '/SYS:' + after(':\',unmaildir))
else
writeln(systime,' ',count,' Waffle mail items ',uwmaildir,' ==> ',unmaildir);
if not some then
some := true;
if (count > 0) then
begin
delivered := true;
if not standalone then
begin
str(count,s);
if remotegateway then
send_message_to_username(fruname,'New Mail (n='+ s + ') via UUCP/Waffle.',retcode)
else
send_message_to_username(uname,'New Mail (n='+ s + ') via UUCP/Waffle.',retcode);
end;
end;
{$i+}
end; { docopy }
{$ifdef single}
procedure setupforremote(server,user : string);
begin
writeln('Sorry, this is a single novell server version and cannot deal');
writeln('with remote netware servers. Contact rossl@gmu.wh.su.edu.au for');
writeln('pricing of the source code you need to be able to service multiple');
writeln('servers with a single waffle. Cheaper than MHS !!');
halt(1);
end;
{$else}
procedure setupforremote(server,user : string);
{
called if users forward file contains a remote server/userid
Adjusts nmaildir to the mapped drive on this remote server if successful
login and map achieved and does copy. Otherwise leaves mailbox alone
}
begin
remoteserverid := login(frsname,userobject,remuser,rempass);
if (remoteserverid <> -1) then
begin
if mapremotedrive(remotemapping,'\',remoteserverid,remotehandle) then
begin
unetid := getmaildir(fruname);
if (unetid > '') then
begin
unmaildir := remotenetmaildir + '\' + unetid;
if exists(unmaildir) then
docopy
else
writeln(systime,' No Novell mail directory found - ',frsname,'/',fruname);
end { unetid }
else
writeln(systime,' No netware bindery entry found for user ',frsname,'/',fruname);
logout_from_file_server(remoteserverid);
detach_from_file_server(remoteserverid,dummy);
end { can map }
else
writeln(systime,' Unable to map remote ',remotemapping);
end { can login }
else
writeln(systime,' Login to ',frsname,' to deliver mail as ',remuser,'/',rempass,' failed');
set_preferred_connection_id(defaultserverid);
chdir(homedir);
end; {setupforremote}
{$endif}
procedure forwardmail;
{
this user has a forward.p file
read it and send a copy of mailbox to each nominated user
these may be remote or local
}
var
atleastone : boolean;
begin
atleastone := false;
{$i-}
assign(ffile,userforward);
reset(ffile);
if (ioresult <> 0) then
writeln(systime,' Unable to open user forward file ',userforward)
else
repeat
readln(ffile,s);
dummy := ioresult;
if (dummy <> 0) then
begin
writeln(systime,' Read error on ',userforward);
exit;
close(ffile);
end;
s := upcasestr(mirt(s));
if (s > '') and (copy(s,1,1) <> '#') then { not a comment }
begin
atleastone := true;
if (pos('/',s) > 0) then
begin
frsname := before('/',s);
fruname := after('/',s);
remotegateway := true;
end
else
begin
frsname := gateservername;
fruname := s;
uname := s;
remotegateway := false;
end;
if (frsname = gateservername) then
begin { forward to another user on this server }
unetid := getmaildir(fruname);
if (unetid > '') then
begin
unmaildir := netmaildir + '\' + unetid;
if exists(unmaildir) then
docopy
else
writeln(systime,' No Novell mail directory found - ',frsname,'/',uname);
end
else
writeln(systime,' No netware bindery entry found for user ',frsname,'/',uname);
end
else { forward to another user on another server }
setupforremote(frsname,fruname);
end; { not comment }
until eof(ffile);
{$i-}
if not atleastone then
begin { oh dear, dud forward.p - send to this uname }
writeln(systime,' FORWARD.P for ',uname,' HAS NO ENTRIES !!');
unetid := getmaildir(uname);
if (unetid > '') then
begin
unmaildir := netmaildir + '\' + unetid;
if exists(unmaildir) then
docopy
else
writeln(systime,' No Novell mail directory found - ',uname);
end
else
writeln(systime,' No netware bindery entry found for user ',uname);
end
end; { forwardmail }
begin { copymail }
remotegateway := false;
uwmaildir := userdir + '\' + uname;
usermailbox := uwmaildir + '\' + mb;
userindex := uwmaildir + '\' + mbi;
userforward := uwmaildir + '\' + forwardfilename;
if exists(usermailbox) then
begin
delivered := false;
if logdirs then
write(' mailbox found - ',usermailbox,' ');
if exists(userforward) and not standalone then
begin
if logdirs then
writeln(' has forward file');
forwardmail;
set_preferred_connection_id(defaultserverid);
chdir(homedir);
end { has a forward file }
else
begin { ordinary delivery }
if logdirs then
writeln(' has no forward file');
unetid := getmaildir(uname);
if (unetid > '') then
begin
unmaildir := netmaildir + '\' + unetid;
if exists(unmaildir) then
docopy
else
writeln(systime,' No Novell mail directory found - ',unmaildir);
end
else
writeln(systime,' No netware bindery entry found for user ',uname);
end; { no forward file }
if killfile then
begin { clean up }
if delivered then
begin
{$i-}
assign(f,usermailbox);
erase(f);
dummy := ioresult;
if (dummy <> 0) then
begin
writeln(systime, ' Error erasing file ',usermailbox);
writeln('Is it readonly or do you have erase rights ??? ');
end;
usermailbox := uwmaildir + '\' + mbi;
assign(f,usermailbox);
erase(f);
dummy := ioresult;
if (dummy <> 0) then
begin
writeln(systime,' Error erasing file ',usermailbox);
writeln('Is it readonly or do you have erase rights ??? ');
end;
{$i+}
end { delivered }
else
writeln(systime,' ',usermailbox,' NOT deleted as Mail NOT DELIVERED');
end
else
writeln(systime,' ',usermailbox,' NOT deleted - /d parameter supplied');
end { no waffle mailbox }
else
begin
if debug then
writeln(systime, ' No mailbox found - ',usermailbox);
if logdirs then
writeln(' no mailbox found')
end;
end; { copymail }
begin { scanmaildirs }
findfirst(userdir + '\*.*',directory,s);
while (doserror = 0) do
begin
if (s.name <> '.') and (s.name <> '..') then
begin
if logdirs then
write('Processing ',s.name);
copymail(s.name);
end;
findnext(s);
end;
end; { scanmaildirs }
begin { wafpeg main }
if (pos('ß',ver) <> 0) then
begin
writeln(copyright);
writeln(copyright2);
writeln('This is a BETA TEST VERSION - please do not distribute !!!');
end;
assign(input,''); { enable redirection of log output }
reset(input);
assign(output,'');
rewrite(output);
randomize;
userdir := findwuserdir;
j := length(userdir);
if (j > 1) and (copy(userdir,j,1) = '\') then
userdir := copy(userdir,1,pred(j));
if not apiavailable then
begin
standalone := true;
netmaildir := userdir;
end;
killfile := true;
for i := 1 to paramcount do
begin
s := paramstr(i);
c := upcase(s[2]); { eg /N }
case c of
'N' : begin
netmaildir := copy(s,3,999);
j := length(netmaildir);
if (j > 1) and (copy(netmaildir,j,1) = '\') then
netmaildir := copy(netmaildir,1,pred(j));
end;
'D' : killfile := false;
'U' : remuser := copy(s,3,999);
'P' : rempass := copy(s,3,999);
'H','?' : dohelp;
'L' : logdirs := true;
'A' : allmail := true;
else
writeln(systime,' Bad parameter (#',i,') = ',s);
end;
end;
if not exists(netmaildir + '\*.*') then
begin
if (standalone) then
begin
writeln('In standalone mode, the -n parameter defaults to the');
writeln('waffle static file User directory (',userdir,')');
writeln('Please check the documentation !');
end;
paramerror('Cannot locate netware mail directory ' + netmaildir);
end;
if not exists(userdir) then
paramerror('Cannot locate waffle user directory ' + userdir);
if not standalone then
begin
get_default_connection_id(defaultserverid);
get_file_server_name(defaultserverid,gateservername);
getdir(0,homedir);
if allmail then
begin
writeln('Warning - parameter error');
writeln('The -a parameter (All mail) is ONLY meaningful in standalone');
writeln('mode - ignored as Netware shell detected');
end;
end
else
gateservername := 'Waffle on ' + hostname ;
writeln('|');
writeln(progname,' invoked ',rfc822date);
writeln(version);
if paramcount < 1 then
begin
writeln(systime, ' Using ',userdir,' as waffle user directory');
writeln('and ',netmaildir,' as netware mail directory');
end;
if not killfile then
begin
writeln(systime,' In NON KILL mode - processed mailboxes will NOT BE DELETED !');
writeln('Remember, mail will be repeatedly delivered until the -d flag is NOT used');
end;
scanmaildirs;
if not some then
writeln(systime,' (Yawn) Nothing to do');
end.
{
end wafpeg.pas
rml started June 1992 - derived from Brendan Murray's FILTER.C
}